home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / ZROOTS.DEM < prev    next >
Text File  |  1991-05-01  |  1KB  |  53 lines
  1. PROGRAM d9r11(input,output);
  2. (* driver for routine ZROOTS *)
  3. CONST
  4.    m=4;
  5.    twomp2=10;   (* twomp2=(2*m+2) *)
  6. TYPE
  7.    glcarray = ARRAY [1..twomp2] OF real;
  8.    gl2array = ARRAY [1..2] OF real;
  9. VAR
  10.    i : integer;
  11.    polish : boolean;
  12.    a,roots : glcarray;
  13.  
  14. (*$I MODFILE.PAS *)
  15. (*$I LAGUER.PAS *)
  16.  
  17. (*$I ZROOTS.PAS *)
  18.  
  19. BEGIN
  20.    a[1] := 0.0; a[2] := 2.0;
  21.    a[3] := 0.0; a[4] := 0.0;
  22.    a[5] := -1.0; a[6] := -2.0;
  23.    a[7] := 0.0; a[8] := 0.0;
  24.    a[9] := 1.0; a[10] := 0.0;
  25.    writeln('Roots of the polynomial x^4-(1+2i)*x^2+2i');
  26.    polish := false;
  27.    zroots(a,m,roots,polish);
  28.    writeln;
  29.    writeln('Unpolished roots:');
  30.    writeln('root #':14,'real':13,'imag.':13);
  31.    FOR i := 1 to m DO BEGIN
  32.       writeln(i:11,' ':5,roots[2*i-1]:12:6,roots[2*i]:12:6)
  33.    END;
  34.    writeln;
  35.    writeln('Corrupted roots:');
  36.    FOR i := 1 to m DO BEGIN
  37.       roots[2*i-1] := roots[2*i-1]*(1+0.01*i);
  38.       roots[2*i] := roots[2*i]*(1+0.01*i)
  39.    END;
  40.    writeln('root #':14,'real':13,'imag.':13);
  41.    FOR i := 1 to m DO BEGIN
  42.       writeln(i:11,' ':5,roots[2*i-1]:12:6,roots[2*i]:12:6)
  43.    END;
  44.    polish := true;
  45.    zroots(a,m,roots,polish);
  46.    writeln;
  47.    writeln('Polished roots:');
  48.    writeln('root #':14,'real':13,'imag.':13);
  49.    FOR i := 1 to m DO BEGIN
  50.       writeln(i:11,' ':5,roots[2*i-1]:12:6,roots[2*i]:12:6)
  51.    END
  52. END.
  53.